﻿{ ******************************************************* }
{ }
{ DelphiWebMVC 5.0 }
{ E-Mail:pearroom@yeah.net }
{ 版权所有 (C) 2022-2 苏兴迎(PRSoft) }
{ }
{ ******************************************************* }
unit MVC.DSMemTable;

interface

uses
  FireDAC.Phys.FBDef, FireDAC.Phys.FB, FireDAC.DApt, Data.DB, system.Classes,
  FireDAC.Stan.Intf, FireDAC.Comp.Client, mvc.Config, mvc.Tool, system.SysUtils,
  mvc.LogUnit, System.JSON;

type
  TDSMemTable = class(TFDMemTable)
  private
    function GetB(key: string): boolean;
    function GetD(key: string): TDateTime;
    function GetF(key: string): double;
    function GetI(key: string): integer;
    function GetS(key: string): string;
    procedure SetB(key: string; const Value: boolean);
    procedure SetD(key: string; const Value: TDateTime);
    procedure SetF(key: string; const Value: double);
    procedure SetI(key: string; const Value: integer);
    procedure SetS(key: string; const Value: string);
    function checkType(dbtype: TFieldType): Boolean;
  public
    property S[key: string]: string read GetS write SetS;
    property I[key: string]: integer read GetI write SetI;
    property B[key: string]: boolean read GetB write SetB;
    property D[key: string]: TDateTime read GetD write SetD;
    property F[key: string]: double read GetF write SetF;
    function toJSONArray: string;
    function toJSONObject: string;
  end;

implementation
{ TDSQuery }

function TDSMemTable.GetB(key: string): boolean;
begin
  Result := FieldByName(key).value;
end;

function TDSMemTable.GetD(key: string): TDateTime;
begin
  Result := FieldByName(key).value;
end;

function TDSMemTable.GetF(key: string): double;
begin
  Result := FieldByName(key).value;
end;

function TDSMemTable.GetI(key: string): integer;
begin
  Result := FieldByName(key).value;
end;

function TDSMemTable.GetS(key: string): string;
begin
  Result := FieldByName(key).value;
end;

procedure TDSMemTable.SetB(key: string; const Value: boolean);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSMemTable.SetD(key: string; const Value: TDateTime);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSMemTable.SetF(key: string; const Value: double);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSMemTable.SetI(key: string; const Value: integer);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSMemTable.SetS(key: string; const Value: string);
begin
  FieldByName(key).Value := Value;
end;

function TDSMemTable.checkType(dbtype: TFieldType): Boolean;
begin
  if dbtype in [
    ftString,
    ftWideString,
    ftUnknown,
    ftWideMemo,
    ftMemo,
    ftDate,
    ftDateTime,
    ftTime,
    ftFmtMemo,
    ftTimeStamp,
    ftTimeStampOffset] then
  begin
    Result := true;
  end
  else
  begin
    Result := false;
  end;
end;

function TDSMemTable.toJSONArray: string;
var
  k: Integer;
  ret: string;
  ftype: TFieldType;
  json, item, key, value: string;
  aStream: TStringStream;
begin
  ret := '';
  try
    if IsEmpty or (not Self.Active) then
    begin
      Result := '[]';
      exit;
    end;
    json := '';
   // Lock(Self);
    First;

    while not Eof do
    begin
      item := '';
      for k := 0 to Fields.Count - 1 do
      begin
        key := Fields[k].DisplayLabel;

        ftype := Fields[k].DataType;
        if Config.JsonFmt <> '' then
          key := IITool.fmtKey(Config.JsonFmt, key);
        if Config.JsonToLower then
          key := key.ToLower;

        if checkType(ftype) then
        begin
          value := Fields[k].AsString;
          value := '"' + IITool.StringFormat(value) + '"'
        end
        else if ftype = ftBoolean then
        begin
          value := Fields[k].AsString;
          value := value.ToLower;
          if (value = '') or (value = '0') then
            value := 'false'
          else if value = '1' then
            value := 'true';
        end
        else if ftype = ftBlob then
        begin
          aStream := TStringStream.Create('', TEncoding.UTF8, True);
          try
            TBlobField(Fields[k]).SaveToStream(aStream);
            aStream.position := 0;
            value := '"' + aStream.DataString + '"';
          finally
            aStream.Free;
          end;
        end
        else
          value := Fields[k].AsString;
        if value = '' then
          value := '0';
        item := item + '"' + key + '"' + ':' + value + ',';
      end;
      item := copy(item, 1, item.Length - 1);
      item := '{' + item + '},';
      json := json + item;
      Next;
    end;
   // UnLock(self);
    if json.Length > 1 then
      json := copy(json, 1, json.Length - 1);
    json := '[' + json + ']';
    Result := json;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

function TDSMemTable.toJSONObject: string;
var
  k: Integer;
  ftype: TFieldType;
  json, item, key, value: string;
  aStream: TStringStream;
begin
  json := '';
  try
    if IsEmpty or (not self.Active) then
    begin
      Result := '{}';
      exit;
    end;

    if not IsEmpty then
    begin
     // Lock(Self);
      item := '{';
      for k := 0 to Fields.Count - 1 do
      begin
        key := Fields[k].DisplayLabel;

        ftype := Fields[k].DataType;
        if Config.JsonFmt <> '' then
          key := IITool.fmtKey(Config.JsonFmt, key);
        if Config.JsonToLower then
          key := key.ToLower;

        if checkType(ftype) then
        begin
          value := Fields[k].AsString;
          value := '"' + IITool.StringFormat(value) + '"'
        end
        else if ftype = ftBoolean then
        begin
          value := Fields[k].AsString;
          value := value.ToLower;
          if (value = '') or (value = '0') then
            value := 'false'
          else if value = '1' then
            value := 'true';
        end
        else if ftype = ftBlob then
        begin
          aStream := TStringStream.Create('', TEncoding.UTF8, True);
          try
            TBlobField(Fields[k]).SaveToStream(aStream);
            aStream.position := 0;
            value := '"' + aStream.DataString + '"';
          finally
            aStream.Free;
          end;
        end
        else
          value := Fields[k].AsString;
        if value = '' then
          value := '0';
        item := item + '"' + key + '"' + ':' + value + ',';
      end;
      item := copy(item, 1, item.Length - 1);
      item := item + '},';
      json := json + item;
    end;
   // unLock(Self);
    if json.Length > 1 then
      json := copy(json, 1, json.Length - 1);
    Result := json;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

end.

